COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00010 ENDMK
C⊗;
ENTRY;
BEGIN
INTERNAL RECORD_CLASS ISTACK(INTEGER ARRAY STACK;INTEGER TOP,LIMIT);
INTERNAL RECORD_CLASS FSTACK(REAL ARRAY STACK; INTEGER TOP,LIMIT);
INTERNAL RECORD_CLASS RSTACK(RECORD_POINTER(ANY_CLASS) ARRAY STACK; INTEGER TOP,LIMIT);
DEFINE RPTR="RECORD_POINTER";
COMMENT range of stack is 1 to LIMIT, and the first element in the stack is at 1.
	TOP represents the current top, and LIMIT the maximum;

DEFINE NEW_STACK(STACKTYPE,ELEMENTTYPE) "[][]" =
	[ BEGIN
	RPTR(STACKTYPE) PTR;
	ELEMENTTYPE ARRAY ARR[1:SIZE];
	PTR←NEW_RECORD(STACKTYPE);
	STACKTYPE:LIMIT[PTR]←SIZE;
	STACKTYPE:TOP[PTR]←0;
	MEMORY[LOCATION(STACKTYPE:STACK[PTR])]↔MEMORY[LOCATION(ARR)];
	RETURN(PTR);
	END;];

DEFINE POP(STACKTYPE,DEF)"[][]"=[
	BEGIN  INTEGER TOP;
	IF (TOP←STACKTYPE:TOP[PTR])=0
		THEN BEGIN
			PRINT("UNDERFLOW IN STACKTYPE STACK: RETURNING DEFAULT");
			RETURN(DEF);
		     END;
	STACKTYPE:TOP[PTR]←TOP -1;
	RETURN(STACKTYPE:STACK[PTR][TOP]);
	END];

DEFINE PUSH(STACKTYPE,ELEMENT,ELEMENTTYPE)"[][]"=[
	BEGIN
	INTEGER TOP,NLIMIT;
	IF (TOP←STACKTYPE:TOP[PTR])=STACKTYPE:LIMIT[PTR]
		THEN BEGIN "increase size of stack"
			ELEMENTTYPE ARRAY ARR[1:NLIMIT←TOP*1.25+10];
			ARRTRAN(ARR,STACKTYPE:STACK[PTR]);
			STACKTYPE:LIMIT[PTR]←NLIMIT;
			MEMORY[LOCATION(STACKTYPE:STACK[PTR])]↔MEMORY[LOCATION(ARR)];
		    END;
	STACKTYPE:TOP[PTR]←(TOP←TOP+1);
	STACKTYPE:STACK[PTR][TOP]←ELEMENT;
	END];

DEFINE TRIM(STACKTYPE,ELEMENTTYPE)"[][]"=[
	BEGIN
	INTEGER TOP;
	ELEMENTTYPE ARRAY ARR[1:TOP←STACKTYPE:TOP[PTR]];
	ARRBLT(ARR[1],STACKTYPE:STACK[PTR][1],TOP);
	MEMORY[LOCATION(STACKTYPE:STACK[PTR])]↔MEMORY[LOCATION(ARR)];
	STACKTYPE:LIMIT[PTR]←TOP;
	END;];

DEFINE JOIN(P1,P2,ELEMENTYPE,NEWSTACKROUTINE,STACKTYPE)"[][]"=[
	BEGIN
	RPTR(STACKTYPE)P3;
	INTEGER TOP1,TOP2,TOP3,LIMIT;
	TOP1←STACKTYPE:TOP[P1];
	TOP2←STACKTYPE:TOP[P2];
	P3←NEWSTACKROUTINE(TOP3←(TOP1+TOP2)*1.25+10);
	ARRBLT(STACKTYPE:STACK[P3][1],STACKTYPE:STACK[P1][1],TOP1);
	ARRBLT(STACKTYPE:STACK[P3][TOP1+1],STACKTYPE:STACK[P2][1],TOP2);
	STACKTYPE:TOP[P3]←TOP1+TOP2;
	RETURN(P3);
	END;];

DEFINE ATTACH(P1,P2,ELEMENTYPE,STACKTYPE)"[][]"=[
	BEGIN
	RPTR(STACKTYPE)P3;
	INTEGER TOP1,TOP2,TOP3,LIMIT;
	TOP1←STACKTYPE:TOP[P1];
	TOP2←STACKTYPE:TOP[P2];
	TOP3←TOP1+TOP2;
	IF STACKTYPE:LIMIT[P1]<TOP3
		THEN BEGIN
			ELEMENTYPE ARRAY ARR[1:STACKTYPE:LIMIT[P1]←TOP3*1.25+10];
			ARRBLT(ARR[1],STACKTYPE:STACK[P1][1],TOP1);
			MEMORY[LOCATION(ARR)]↔MEMORY[LOCATION(STACKTYPE:STACK[P1])];
		     END;
	ARRBLT(STACKTYPE:STACK[P3][TOP1+1],STACKTYPE:STACK[P2][1],TOP2);
	STACKTYPE:TOP[P1]←TOP3;
	END;];

REQUIRE "[][]" DELIMITERS;
INTERNAL RPTR(ISTACK)PROCEDURE NEW_ISTACK(INTEGER SIZE(10));
	NEW_STACK(ISTACK,INTEGER);
INTERNAL RPTR(FSTACK)PROCEDURE NEW_FSTACK(INTEGER SIZE(10));
	NEW_STACK(FSTACK,REAL);
INTERNAL RPTR(RSTACK)PROCEDURE NEW_RSTACK(INTEGER SIZE(10));
	NEW_STACK(RSTACK,[RECORD_POINTER(ANY_CLASS)]);

INTERNAL INTEGER PROCEDURE IPOP(RPTR(ISTACK)PTR);
	POP(ISTACK,0);
INTERNAL REAL PROCEDURE FPOP(RPTR(FSTACK)PTR);
	POP(FSTACK,0.0);
INTERNAL RPTR(ANY_CLASS) PROCEDURE RPOP(RPTR(RSTACK)PTR);
	POP(RSTACK,NULL_RECORD);

INTERNAL PROCEDURE ISPUSH(RPTR(ISTACK)PTR; INTEGER ELEMENT);
	PUSH(ISTACK,ELEMENT,INTEGER);
INTERNAL PROCEDURE FSPUSH(RPTR(FSTACK)PTR; REAL ELEMENT);
	PUSH(FSTACK,ELEMENT,REAL);
INTERNAL PROCEDURE RPUSH(RPTR(RSTACK)PTR; RPTR(ANY_CLASS)ELEMENT);
	PUSH(RSTACK,ELEMENT,[RPTR(ANY_CLASS)]);

INTERNAL RPTR(ISTACK)PROCEDURE IJOIN(RPTR(ISTACK)P1,P2);
	JOIN(P1,P2,INTEGER,NEW_ISTACK,ISTACK);
INTERNAL RPTR(FSTACK)PROCEDURE FJOIN(RPTR(FSTACK)P1,P2);
	JOIN(P1,P2,REAL,NEW_FSTACK,FSTACK);
INTERNAL RPTR(RSTACK)PROCEDURE RJOIN(RPTR(RSTACK)P1,P2);
	JOIN(P1,P2,[RPTR(ANY_CLASS)],NEW_RSTACK,RSTACK);

INTERNAL PROCEDURE IATTACH(RPTR(ISTACK)P1,P2);
	ATTACH(P1,P2,INTEGER,ISTACK);
INTERNAL PROCEDURE FATTACH(RPTR(FSTACK)P1,P2);
	ATTACH(P1,P2,REAL,FSTACK);
INTERNAL PROCEDURE RATTACH(RPTR(RSTACK)P1,P2);
	ATTACH(P1,P2,[RPTR(ANY_CLASS)],RSTACK);

INTERNAL PROCEDURE ITRIM(RPTR(ISTACK)PTR);
	TRIM(ISTACK,INTEGER);
INTERNAL PROCEDURE FTRIM(RPTR(FSTACK)PTR);
	TRIM(FSTACK,REAL);
INTERNAL PROCEDURE RTRIM(RPTR(RSTACK)PTR);
	TRIM(RSTACK,[RPTR(ANY_CLASS)]);

INTERNAL PROCEDURE ZERO_ISTACK(RPTR(ISTACK)PTR);
	ISTACK:TOP[PTR]←0;
INTERNAL PROCEDURE ZERO_FSTACK(RPTR(FSTACK)PTR);
	FSTACK:TOP[PTR]←0;
INTERNAL PROCEDURE ZERO_RSTACK(RPTR(RSTACK)PTR);
	RSTACK:TOP[PTR]←0;
	
END;